home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Sapphire Collection / Software Vault (Sapphire Collection) (Digital Impact).ISO / cdr08 / mygroups.zip / GRPFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-29  |  15KB  |  434 lines
  1. Unit GrpFile;
  2. {This unit provides various functions to read data from the Windows
  3.  group files}
  4. Interface
  5.  
  6. Uses WinTypes;
  7.  
  8. Type IconEnum = Procedure(Icon:hIcon);
  9.  
  10. Function GetIcon(Group:PChar; Index:Integer):hIcon;
  11. Procedure EnumIcons(Group:PChar; EnumProc:IconEnum);
  12. Function GetGroupName(Description:PChar; GroupName:PChar; Len:Word):PChar;
  13. Function GetGroupDDE(Group:PChar):PChar;
  14.  
  15. Implementation
  16.  
  17. Uses WinProcs, Strings;
  18.  
  19. Type tagGroupHeader = Record  {Group file fixed length header}
  20.         identifier:Array [0..3] of Char; {always 'PMCC'}
  21.         wCheckSum:Word;                  {file checksum}
  22.         cbGroup:Word;                    {size of Windows 3.0 compatible
  23.          portion of file. In Win 3.1 it is the offset to the tagdata.}
  24.         nCmdShow:Word;                   {Normal, minimized, maximized}
  25.         rcNormal:TRect;                  {Rectangle for show normal}
  26.         ptMin:TPoint;                    {Point for show minimized}
  27.         pName:Word;                      {Offset of description}
  28.         wLogPixelsX:Word;                {Width of icon}
  29.         wLogPixelsY:Word;                {Height of icon}
  30.         Case Boolean of
  31.            False: (wBitsperPixel:Word;    {Windows 3.0}
  32.                    wPlanes:Word;          {Windows 3.0}
  33.                    cItems:Word);          {Windows 3.0 & 3.1} {Number of items
  34.                       in the griItems array}
  35.            True:  (bBitsperPixel:Byte;    {Windows 3.1}
  36.                    bPlanes:Byte;          {Windows 3.1}
  37.                    cItems31:Word;         {Windows 3.0 & 3.1 duplicates cItems}
  38.                    Reserved:Word);
  39.         {rgiItems:Array [0..cItems-1] of Word;} {array of offsets to tagItemInfo items}
  40.         End;
  41.  
  42. Type tagItemInfo = Record   {Data for an individual program}
  43.         pt:TPoint;          {Point for program icon}
  44.         iIcon:Word;         {Index of icon in icon file}
  45.         cbHeader:Word;      {Size of tagCURSORSHAPE}
  46.         cbANDPlane:Word;    {Size of AND bits for icon}
  47.         cbXORPlane:Word;    {Size of XOR bits for icon}
  48.         pHeader:Word;       {Offset of a tagCURSORSHAPE}
  49.         pANDPlane:Word;     {Offset of AND bits for icon}
  50.         pXORPlane:Word;     {Offset of XOR bits for icon}
  51.         pName:Word;         {Offset of description of program}
  52.         pCommand:Word;      {Offset of command line for program}
  53.         pIconPath:Word;     {Offset of icon file name}
  54.         End;
  55.  
  56. Type tagCURSORSHAPE = Record  {Info about icon for a program}
  57.         xHotSpot:Integer;   {Always 0}
  58.         yHotSpot:Integer;   {Always 0}
  59.         cx:Integer;         {width of program icon}
  60.         cy:Integer;         {height of program icon}
  61.         cbWidth:Integer;    {Bytes of data per row
  62.                               accounting for WORD alignment.}
  63.         bPlanes:Byte;       {Number of display planes for icon}
  64.         bBitsPixel:Byte;    {Bits per pixel for icon}
  65.         End;
  66.  
  67. Type tagTAGDATA = Record {Windows 3.1 auxillary info}
  68.         wID:Word;        { $8101 for path, $8102 for hotkey, $8103 for minimized}
  69.                          { $8000 for first tagdata; path element of 'PMCC'}
  70.                          { $FFFF for last tagdata}
  71.         wItem:Word;      {Program index that tag refers to}
  72.         cb:Word;         {Size of TAGDATA data structure}
  73.         Case Boolean of
  74.            False:  (Path:Array [0..255] of Char);  {Path}
  75.            True:   (HotKey:Word);                  {Program hotkey}
  76.         End;
  77.  
  78. Type WArray = Array [0..0] of Word;
  79. Type PArray = ^WArray;
  80.  
  81. Var GroupHeader:tagGroupHeader;
  82.     ItemInfo:tagItemInfo;
  83.     CursorShape:tagCURSORSHAPE;
  84.     TagData:tagTAGDATA;
  85.     Grp:File;
  86.     rgiItems:PArray;
  87.  
  88. Function OpenGroup(FName:PChar):Integer;
  89. {Internal function. Opens a group file, loads the fixed header (GroupHeader)
  90.  and loads the variable length header (rgiItems).
  91.  Returns 0 if everything OK.
  92.  
  93.  Input:  FName - Name of group file}
  94.  
  95. Var OldFileMode:Byte;
  96.     Result:Integer;
  97.     Len,I,J:Word;
  98.  
  99.    Begin
  100.    OldFileMode:=FileMode;
  101.    FileMode:=0;
  102.    Assign(Grp,FName);
  103.    {$I-} Reset(Grp,1); {$I+}
  104.    Result:=IOResult;
  105.    OpenGroup:=Result;
  106.    FileMode:=OldFileMode;
  107.    If Result = 0 then
  108.       Begin  {Read the fixed header}
  109.       BlockRead(Grp,GroupHeader,Sizeof(GroupHeader),Len);
  110.       If (Len <> Sizeof(GroupHeader)) or
  111.          (StrLComp(GroupHeader.identifier,'PMCC',4) <> 0)then
  112.          {If I wanted to be really rigorous here, I could read the entire
  113.           file as WORD items and the sum should be zero. The wCheckSum word
  114.           is adjusted to insure this.}
  115.          Begin
  116.          OpenGroup:=1;
  117.          Close(Grp);
  118.          Exit;
  119.          End;
  120.       rgiItems:=Nil;    {Now load the variable length header section}
  121.       If GroupHeader.cItems = 0 then Exit;
  122.       GetMem(rgiItems,GroupHeader.cItems*Sizeof(Word));
  123.       BlockRead(Grp,rgiItems^,GroupHeader.cItems*Sizeof(Word),Len);
  124.       If Len <> GroupHeader.cItems*Sizeof(Word) then
  125.          Begin
  126.          OpenGroup:=1;
  127.          Close(Grp);
  128.          FreeMem(rgiItems,GroupHeader.cItems*Sizeof(Word));
  129.          rgiItems:=Nil;
  130.          Exit;
  131.          End;
  132.       End;
  133.    End;
  134.  
  135. Procedure CloseGroup;
  136. {Internal procedure. Closes the group file and frees any memory allocated
  137.  by OpenGroup.}
  138.  
  139.    Begin
  140.    If rgiItems <> Nil then
  141.       FreeMem(rgiItems,GroupHeader.cItems*Sizeof(Word));
  142.    Close(Grp);
  143.    End;
  144.  
  145. Function ReadIcon(Index:Word):hIcon;
  146. {Internal function. Loads an icon from the group file.
  147.  Returns the handle of the icon.
  148.  
  149.  Input:  Index - the index in rgiItems of the program for which to load
  150.                  the icon}
  151.  
  152. Var ANDBits,XORBits:Pointer;
  153.     Len:Word;
  154.  
  155.    Begin
  156.    ReadIcon:=0;
  157.    If (rgiItems = Nil) or (rgiItems^[Index] = 0) then Exit;
  158.    Seek(Grp,rgiItems^[Index]);
  159.    BlockRead(Grp,ItemInfo,Sizeof(ItemInfo),Len);
  160.    If Len <> Sizeof(ItemInfo) then Exit;
  161.    Seek(Grp,ItemInfo.pHeader);
  162.    Blockread(Grp,CursorShape,Sizeof(CursorShape),Len);
  163.    If Len <> Sizeof(CursorShape) then Exit;
  164.    GetMem(ANDBits,ItemInfo.cbANDPlane);
  165.    GetMem(XORBits,ItemInfo.cbXORPlane);
  166.    Seek(Grp,ItemInfo.pANDPlane);
  167.    BlockRead(Grp,ANDBits^,ItemInfo.cbANDPlane,Len);
  168.    If Len = ItemInfo.cbANDPlane then
  169.       Begin
  170.       Seek(Grp,ItemInfo.pXORPlane);
  171.       BlockRead(Grp,XORBits^,ItemInfo.cbXORPlane,Len);
  172.       If Len = ItemInfo.cbXORPlane then
  173.          ReadIcon:=CreateIcon(hInstance,CursorShape.cx,
  174.             CursorShape.cy,CursorShape.bPlanes,
  175.             CursorShape.bBitsPixel,ANDBits,XORBits);
  176.       End;
  177.    FreeMem(XORBits,ItemInfo.cbXORPlane);
  178.    FreeMem(ANDBits,ItemInfo.cbANDPlane);
  179.    End;
  180.  
  181. Function GetProgramPath(Index:Word):PChar;
  182. {Internal function. Returns a pointer to the program path if found,
  183.  else returns a pointer to an empty string.
  184.  
  185.  Input:  Index - The index of the program item}
  186.  
  187. Var Len:Integer;
  188.  
  189.    Begin
  190.    GetProgramPath:=@TagData.Path;
  191.    Seek(Grp,GroupHeader.cbGroup);
  192.    BlockRead(Grp,TagData,Sizeof(TagData)-Sizeof(TagData.Path),Len);
  193.    While (Len = (Sizeof(TagData)-Sizeof(TagData.Path))) and
  194.          (TagData.wID <> $FFFF) do
  195.       Begin
  196.       If TagData.cb > Sizeof(TagData)-Sizeof(TagData.Path) then
  197.          BlockRead(Grp,TagData.Path,TagData.cb-(Sizeof(TagData)-Sizeof(TagData.Path)),Len);
  198.       If (TagData.wID = $8101) and (TagData.wItem = Index) then
  199.          Len:=0
  200.       else
  201.          BlockRead(Grp,TagData,Sizeof(TagData)-Sizeof(TagData.Path),Len);
  202.       End;
  203.    If (TagData.wID <> $8101) or (TagData.wItem <> Index) then
  204.       TagData.Path[0]:=#0;
  205.    End;
  206.  
  207. Function GetProgramHotKey(Index:Word):Word;
  208. {Internal function. Returns the hotkey for the program if found else zero.
  209.  
  210.  Input:  Index - The index of the program item}
  211.  
  212. Var Len:Integer;
  213.  
  214.    Begin
  215.    GetProgramHotKey:=0;
  216.    Seek(Grp,GroupHeader.cbGroup);
  217.    BlockRead(Grp,TagData,Sizeof(TagData)-Sizeof(TagData.Path),Len);
  218.    While (Len = (Sizeof(TagData)-Sizeof(TagData.Path))) and
  219.          (TagData.wID <> $FFFF) do
  220.       Begin
  221.       If TagData.cb > Sizeof(TagData)-Sizeof(TagData.Path) then
  222.          BlockRead(Grp,TagData.Path,TagData.cb-(Sizeof(TagData)-Sizeof(TagData.Path)),Len);
  223.       If (TagData.wID = $8102) and (TagData.wItem = Index) then
  224.          Begin
  225.          GetProgramHotKey:=TagData.HotKey;
  226.          Len:=0;
  227.          End
  228.       else
  229.          BlockRead(Grp,TagData,Sizeof(TagData)-Sizeof(TagData.Path),Len);
  230.       End;
  231.    End;
  232.  
  233. Function GetProgramMinFlag(Index:Word):Boolean;
  234. {Internal function. Returns TRUE if the program runs minimized.
  235.  
  236.  Input:  Index - The index of the program item}
  237.  
  238. Var Len:Integer;
  239.  
  240.    Begin
  241.    GetProgramMinFlag:=False;
  242.    Seek(Grp,GroupHeader.cbGroup);
  243.    BlockRead(Grp,TagData,Sizeof(TagData)-Sizeof(TagData.Path),Len);
  244.    While (Len = (Sizeof(TagData)-Sizeof(TagData.Path))) and
  245.          (TagData.wID <> $FFFF) do
  246.       Begin
  247.       If TagData.cb > Sizeof(TagData)-Sizeof(TagData.Path) then
  248.          BlockRead(Grp,TagData.Path,TagData.cb-(Sizeof(TagData)-Sizeof(TagData.Path)),Len);
  249.       If (TagData.wID = $8103) and (TagData.wItem = Index) then
  250.          Begin
  251.          GetProgramMinFlag:=True;
  252.          Len:=0;
  253.          End
  254.       else
  255.          BlockRead(Grp,TagData,Sizeof(TagData)-Sizeof(TagData.Path),Len);
  256.       End;
  257.    End;
  258.  
  259. Function GetIcon(Group:pChar; Index:Integer):hIcon;
  260. {External function. Loads an icon from a group file.
  261.  Returns the handle to the icon.
  262.  
  263.  Input:  Group - The name of the group file
  264.          Index - The index in rgiItems of the program icon}
  265.  
  266.    Begin
  267.    GetIcon:=0;
  268.    If OpenGroup(Group) <> 0 then Exit;
  269.    If GroupHeader.cItems > Index  then
  270.       GetIcon:=ReadIcon(Index);
  271.    CloseGroup;
  272.    End;
  273.  
  274. Procedure EnumIcons(Group:PChar; EnumProc:IconEnum);
  275. {External procedure. Calls a procedure for each icon in the group file.
  276.  
  277.  Input:  Group - The name of the group file
  278.          EnumProc - The address of the procedure to call. It must have the
  279.                     format: Procedure EnumProc(Icon:hIcon); Far; }
  280.  
  281. Var I:Word;
  282.     Icon:hIcon;
  283.  
  284.    Begin
  285.    If OpenGroup(Group) <> 0 then Exit;
  286.    If rgiItems <> Nil then
  287.       For I:=0 to GroupHeader.cItems-1 do
  288.          If rgiItems^[I] <> 0 then
  289.             Begin
  290.             Icon:=ReadIcon(I);
  291.             If Icon <> 0 then
  292.                Begin
  293.                EnumProc(Icon);
  294.                DestroyIcon(Icon);
  295.                End;
  296.             End;
  297.    CloseGroup;
  298.    End;
  299.  
  300. Function GetGroupName(Description:PChar; GroupName:PChar; Len:Word):PChar;
  301. {External function. Takes a group description and find the corresponding
  302.  group file. Returns a pointer to the group file name.
  303.  
  304.  Input:  Description - The description under the group icon in the
  305.                        Program Manager
  306.          Len - The length of the output array
  307.  
  308.  Output: GroupName - The output array which receives the file name}
  309.  
  310. Var PG,PGroup,PDesc,FName:PChar;
  311.     I,J,K:Word;
  312.  
  313.    Begin
  314.    GroupName[0]:=#0;
  315.    GetGroupName:=GroupName;
  316.    I:=500;
  317.    GetMem(PGroup,I);
  318.    While GetPrivateProfileString('Groups',Nil,'',PGroup,I,'PROGMAN.INI') = I-1 do
  319.       Begin
  320.       Freemem(PGroup,I);
  321.       Inc(I,500);
  322.       GetMem(PGroup,I);
  323.       End;
  324.    J:=StrLen(Description)+1;
  325.    GetMem(PDesc,J+1);
  326.    GetMem(FName,256);
  327.    PG:=PGroup;
  328.    While (PG^ <> #0) and (GroupName^ = #0) do
  329.       Begin
  330.       If (GetPrivateProfileString('Groups',PG,'',FName,256,'PROGMAN.INI') > 0) and
  331.          (OpenGroup(FName) = 0) then
  332.          Begin
  333.          Seek(Grp,GroupHeader.pName);
  334.          BlockRead(Grp,PDesc^,J,K);
  335.          PDesc[K]:=#0;
  336.          If StrComp(PDesc,Description) = 0 then
  337.             StrLCopy(GroupName,FName,Len);
  338.          CloseGroup;
  339.          End;
  340.       Inc(PG,StrLen(PG)+1);
  341.       End;
  342.    FreeMem(FName,256);
  343.    FreeMem(PDesc,J+1);
  344.    FreeMem(PGroup,I);
  345.    End;
  346.  
  347. Function GetGroupDDE(Group:PChar):PChar;
  348. {External function. This function returns a pointer to a memory area which
  349.  receives data in a format similar (but not quite identical) to the Windows
  350.  3.1 Program Manager DDE interface for a particular group. This function
  351.  will work with Windows 3.0, which does not support that particular
  352.  DDE interface. It is up to the caller to do a StrDispose on the array.
  353.  
  354.  Input:  Group - The name of the group file}
  355.  
  356. Var PDDE,PFinal:PChar;
  357.     I,J,Len:Word;
  358.  
  359.    Procedure Str(I:Word; P:PChar);
  360.    Var S:String [10];
  361.  
  362.       Begin
  363.       System.Str(I,S);
  364.       StrPCopy(P,S);
  365.       End;
  366.  
  367.    Begin
  368.    GetGroupDDE:=Nil;
  369.    If OpenGroup(Group) <> 0 then Exit;
  370.    GetMem(PDDE,(GroupHeader.cItems+1)*1024);
  371.    If PDDE = Nil then
  372.       Begin
  373.       CloseGroup;
  374.       Exit;
  375.       End;
  376.    StrCopy(PDDE,'"');
  377.    Seek(Grp,GroupHeader.pName);
  378.    BlockRead(Grp,StrEnd(PDDE)^,256,Len);
  379.    StrCat(PDDE,'",');
  380.    StrCat(PDDE,Group);
  381.    StrCat(PDDE,',');
  382.    PFinal:=StrEnd(PDDE);
  383.    I:=GroupHeader.cItems;
  384.    If I > 0 then
  385.       For J:=0 to I-1 do
  386.          If rgiItems^[J] = 0 then Dec(I);
  387.    Str(I,PFinal);
  388.    StrCat(PFinal,',');
  389.    Str(GroupHeader.ptMin.Y,StrEnd(PFinal));
  390.    StrCat(PFinal,^M^J);
  391.    If GroupHeader.cItems > 0 then
  392.       For I:=0 to GroupHeader.cItems-1 do
  393.          If rgiItems^[I] <> 0 then
  394.             Begin
  395.             Seek(Grp,rgiItems^[I]);
  396.             BlockRead(Grp,ItemInfo,Sizeof(ItemInfo),Len);
  397.             If Len <> Sizeof(ItemInfo) then
  398.                Begin
  399.                FreeMem(PDDE,(GroupHeader.cItems+1)*1024);
  400.                CloseGroup;
  401.                Exit;
  402.                End;
  403.             PFinal:=StrEnd(PFinal);
  404.             StrCat(PFinal,'"');
  405.             Seek(Grp,ItemInfo.pName);
  406.             BlockRead(Grp,StrEnd(PFinal)^,256,Len);
  407.             StrCat(PFinal,'","');
  408.             Seek(Grp,ItemInfo.PCommand);
  409.             BlockRead(Grp,StrEnd(PFinal)^,256,Len);
  410.             StrCat(PFinal,'",');
  411.             StrCat(PFinal,GetProgrampath(I));
  412.             StrCat(PFinal,',');
  413.             Seek(Grp,ItemInfo.pIconPath);
  414.             BlockRead(Grp,StrEnd(PFinal)^,256,Len);
  415.             StrCat(PFinal,',');
  416.             Str(ItemInfo.pt.x,StrEnd(PFinal));
  417.             StrCat(PFinal,',');
  418.             Str(ItemInfo.pt.y,StrEnd(PFinal));
  419.             StrCat(PFinal,',');
  420.             Str(ItemInfo.iIcon,StrEnd(PFinal));
  421.             StrCat(PFinal,',');
  422.             Str(GetProgramHotKey(I),StrEnd(PFinal));
  423.             StrCat(PFinal,',');
  424.             Str(Byte(GetProgramMinFlag(I)),StrEnd(PFinal));
  425.             StrCat(PFinal,^M^J);
  426.             End;
  427.    PFinal:=StrNew(PDDE);
  428.    FreeMem(PDDE,(GroupHeader.cItems+1)*1024);
  429.    CloseGroup;
  430.    GetGroupDDE:=PFinal;
  431.    End;
  432.  
  433. Begin
  434. End.